home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / mac / tclMacInit.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  7.7 KB  |  276 lines  |  [TEXT/CWIE]
  1. /*
  2.  * tclMacInit.c --
  3.  *
  4.  *    Contains the Mac-specific interpreter initialization functions.
  5.  *
  6.  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  7.  *
  8.  * See the file "license.terms" for information on usage and redistribution
  9.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  *
  11.  * SCCS: @(#) tclMacInit.c 1.37 97/08/13 16:54:24
  12.  */
  13.  
  14. #include <Files.h>
  15. #include <Gestalt.h>
  16. #include <TextUtils.h>
  17. #include <Resources.h>
  18. #include <Strings.h>
  19. #include "tclInt.h"
  20. #include "tclMacInt.h"
  21.  
  22. /*
  23.  *----------------------------------------------------------------------
  24.  *
  25.  * TclPlatformInit --
  26.  *
  27.  *    Performs Mac-specific interpreter initialization related to the
  28.  *      tcl_platform and tcl_library variables.
  29.  *
  30.  * Results:
  31.  *    None.
  32.  *
  33.  * Side effects:
  34.  *    Sets "tcl_library" & "tcl_platfrom" Tcl variable
  35.  *
  36.  *----------------------------------------------------------------------
  37.  */
  38.  
  39. void
  40. TclPlatformInit(
  41.     Tcl_Interp *interp)        /* Tcl interpreter to initialize. */
  42. {
  43.     char *libDir;
  44.     Tcl_DString path, libPath;
  45.     long int gestaltResult;
  46.     int minor, major;
  47.     char versStr[10];
  48.  
  49.     /*
  50.      * Set runtime C variable that tells cross platform C functions
  51.      * what platform they are running on.  This can change at
  52.      * runtime for testing purposes.
  53.      */
  54.     tclPlatform = TCL_PLATFORM_MAC;
  55.     
  56.     /*
  57.      * Define the tcl_platfrom variable.
  58.      */
  59.     Tcl_SetVar2(interp, "tcl_platform", "platform", "macintosh",
  60.         TCL_GLOBAL_ONLY);
  61.     Tcl_SetVar2(interp, "tcl_platform", "os", "MacOS", TCL_GLOBAL_ONLY);
  62.     Gestalt(gestaltSystemVersion, &gestaltResult);
  63.     major = (gestaltResult & 0x0000FF00) >> 8;
  64.     minor = (gestaltResult & 0x000000F0) >> 4;
  65.     sprintf(versStr, "%d.%d", major, minor);
  66.     Tcl_SetVar2(interp, "tcl_platform", "osVersion", versStr, TCL_GLOBAL_ONLY);
  67. #if GENERATINGPOWERPC
  68.     Tcl_SetVar2(interp, "tcl_platform", "machine", "ppc", TCL_GLOBAL_ONLY);
  69. #else
  70.     Tcl_SetVar2(interp, "tcl_platform", "machine", "68k", TCL_GLOBAL_ONLY);
  71. #endif
  72.  
  73.     /*
  74.      * The tcl_library path can be found in one of two places.  As an element
  75.      * in the env array.  Or the default which is to a folder in side the
  76.      * Extensions folder of your system.
  77.      */
  78.      
  79.     Tcl_DStringInit(&path);
  80.     libDir = Tcl_GetVar2(interp, "env", "TCL_LIBRARY", TCL_GLOBAL_ONLY);
  81.     if (libDir != NULL) {
  82.     Tcl_SetVar(interp, "tcl_library", libDir, TCL_GLOBAL_ONLY);
  83.     } else {
  84.     libDir = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
  85.     if (libDir != NULL) {
  86.         Tcl_JoinPath(1, &libDir, &path);
  87.         
  88.         Tcl_DStringInit(&libPath);
  89.         Tcl_DStringAppend(&libPath, ":Tool Command Language:tcl", -1);
  90.         Tcl_DStringAppend(&libPath, TCL_VERSION, -1);
  91.         Tcl_JoinPath(1, &libPath.string, &path);
  92.         Tcl_DStringFree(&libPath);
  93.         Tcl_SetVar(interp, "tcl_library", path.string, TCL_GLOBAL_ONLY);
  94.     } else {
  95.         Tcl_SetVar(interp, "tcl_library", "no library", TCL_GLOBAL_ONLY);
  96.     }
  97.     }
  98.     
  99.     /*
  100.      * Now create the tcl_pkgPath variable.
  101.      */
  102.     Tcl_DStringSetLength(&path, 0);
  103.     libDir = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
  104.     if (libDir != NULL) {
  105.     Tcl_JoinPath(1, &libDir, &path);
  106.     libDir = ":Tool Command Language:";
  107.     Tcl_JoinPath(1, &libDir, &path);
  108.     Tcl_SetVar(interp, "tcl_pkgPath", path.string,
  109.         TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
  110.     } else {
  111.     Tcl_SetVar(interp, "tcl_pkgPath", "no extension folder",
  112.         TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
  113.     }
  114.     Tcl_DStringFree(&path);
  115. }
  116.  
  117. /*
  118.  *----------------------------------------------------------------------
  119.  *
  120.  * TclpCheckStackSpace --
  121.  *
  122.  *    On a 68K Mac, we can detect if we are about to blow the stack.
  123.  *    Called before an evaluation can happen when nesting depth is
  124.  *    checked.
  125.  *
  126.  * Results:
  127.  *    1 if there is enough stack space to continue; 0 if not.
  128.  *
  129.  * Side effects:
  130.  *    None.
  131.  *
  132.  *----------------------------------------------------------------------
  133.  */
  134.  
  135. int
  136. TclpCheckStackSpace()
  137. {
  138.     return StackSpace() > TCL_MAC_STACK_THRESHOLD;
  139. }
  140.  
  141. /*
  142.  *----------------------------------------------------------------------
  143.  *
  144.  * Tcl_Init --
  145.  *
  146.  *    This procedure is typically invoked by Tcl_AppInit procedures
  147.  *    to perform additional initialization for a Tcl interpreter,
  148.  *    such as sourcing the "init.tcl" script.
  149.  *
  150.  * Results:
  151.  *    Returns a standard Tcl completion code and sets interp->result
  152.  *    if there is an error.
  153.  *
  154.  * Side effects:
  155.  *    Depends on what's in the init.tcl script.
  156.  *
  157.  *----------------------------------------------------------------------
  158.  */
  159.  
  160. int
  161. Tcl_Init(
  162.     Tcl_Interp *interp)        /* Interpreter to initialize. */
  163. {
  164.     static char initCmd[] =
  165.     "if {[catch {source -rsrc Init}] != 0} {\n\
  166.     if [file exists [info library]:init.tcl] {\n\
  167.         source [info library]:init.tcl\n\
  168.     } else {\n\
  169.         set msg \"can't find Init resource or [info library]:init.tcl;\"\n\
  170.         append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
  171.         append msg \"TCL_LIBRARY environment variable?\"\n\
  172.         error $msg\n\
  173.     }\n}\n\
  174.         if {[catch {source -rsrc History}] != 0} {\n\
  175.     if [file exists [info library]:history.tcl] {\n\
  176.         source [info library]:history.tcl\n\
  177.     } else {\n\
  178.         set msg \"can't find History resource or [info library]:history.tcl;\"\n\
  179.         append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
  180.         append msg \"TCL_LIBRARY environment variable?\"\n\
  181.         error $msg\n\
  182.     }\n}";
  183.  
  184.     /*
  185.      * For Macintosh applications the Init function may be contained in
  186.      * the application resources.  If it exists we use it - otherwise we
  187.      * look in the tcl_library directory.  Ditto for the history command.
  188.      */
  189.     
  190.     return Tcl_Eval(interp, initCmd);
  191. }
  192.  
  193. /*
  194.  *----------------------------------------------------------------------
  195.  *
  196.  * Tcl_SourceRCFile --
  197.  *
  198.  *    This procedure is typically invoked by Tcl_Main or Tk_Main
  199.  *    procedure to source an application specific rc file into the
  200.  *    interpreter at startup time.  This will either source a file
  201.  *    in the "tcl_rcFileName" variable or a TEXT resource in the
  202.  *    "tcl_rcRsrcName" variable.
  203.  *
  204.  * Results:
  205.  *    None.
  206.  *
  207.  * Side effects:
  208.  *    Depends on what's in the rc script.
  209.  *
  210.  *----------------------------------------------------------------------
  211.  */
  212.  
  213. void
  214. Tcl_SourceRCFile(
  215.     Tcl_Interp *interp)        /* Interpreter to source rc file into. */
  216. {
  217.     Tcl_DString temp;
  218.     char *fileName;
  219.     Tcl_Channel errChannel;
  220.     Handle h;
  221.  
  222.     fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
  223.  
  224.     if (fileName != NULL) {
  225.         Tcl_Channel c;
  226.     char *fullName;
  227.  
  228.         Tcl_DStringInit(&temp);
  229.     fullName = Tcl_TranslateFileName(interp, fileName, &temp);
  230.     if (fullName == NULL) {
  231.         /*
  232.          * Couldn't translate the file name (e.g. it referred to a
  233.          * bogus user or there was no HOME environment variable).
  234.          * Just do nothing.
  235.          */
  236.     } else {
  237.  
  238.         /*
  239.          * Test for the existence of the rc file before trying to read it.
  240.          */
  241.  
  242.             c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
  243.             if (c != (Tcl_Channel) NULL) {
  244.                 Tcl_Close(NULL, c);
  245.         if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
  246.             errChannel = Tcl_GetStdChannel(TCL_STDERR);
  247.             if (errChannel) {
  248.             Tcl_Write(errChannel, interp->result, -1);
  249.             Tcl_Write(errChannel, "\n", 1);
  250.             }
  251.         }
  252.         }
  253.     }
  254.         Tcl_DStringFree(&temp);
  255.     }
  256.  
  257.     fileName = Tcl_GetVar(interp, "tcl_rcRsrcName", TCL_GLOBAL_ONLY);
  258.  
  259.     if (fileName != NULL) {
  260.     c2pstr(fileName);
  261.     h = GetNamedResource('TEXT', (StringPtr) fileName);
  262.     p2cstr((StringPtr) fileName);
  263.     if (h != NULL) {
  264.         if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) {
  265.         errChannel = Tcl_GetStdChannel(TCL_STDERR);
  266.         if (errChannel) {
  267.             Tcl_Write(errChannel, interp->result, -1);
  268.             Tcl_Write(errChannel, "\n", 1);
  269.         }
  270.         }
  271.         Tcl_ResetResult(interp);
  272.         ReleaseResource(h);
  273.     }
  274.     }
  275. }
  276.